home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / day.arc / DAYLIB.PLB < prev   
Encoding:
Text File  |  1985-08-24  |  8.8 KB  |  219 lines
  1. {   DAYLIB.PLB #3.00 85-08-17 TURBO PASCAL CALENDAR-DATE PROCEDURES
  2.  
  3.                V03 L00 Turbo Pascal version cloned on 85-08-17 by Dennis
  4.                        E. Hamilton.  This version has smoother operation than
  5.                        was available in the Small-C clone mother, DAYLIB.CL
  6.                        version #2.04.
  7.  
  8.                V02 L04 84-03-20 SC80 version updated by DEH to take advantage
  9.                        of special fixed-point division entry in SC80.CC #5.06.
  10.                    L00 derivation on 83-10-09 by DEH for use with SC80 Small-C.
  11.  
  12.                V01 L00 created by DEH on 83-10-05 as DATES.PLB, for use with
  13.                        JRT Pascal 3.0, switching ordinal range for use with DRI
  14.                        software date stamps
  15.  
  16.                V00 L00 original Pascal version created by Steve Brecher and
  17.                        distributed on the CompuServe Programmers SIG by memo
  18.                        dated 83-07-13.
  19.  
  20.    These routines represent dates from January 1, 1978 to September 17, 2067
  21.    by the positive number of consecutive days since December 31, 1977.  This is
  22.    the same ordinal day number used by Digital Research CP/M software for date 
  23.    stamping.  (The MSDOS ordinal date is obtained by a simple post-adjustment.
  24.    Negative ordinal date values are also allowed for use as pre-1978 dates,
  25.    being useful for computations using anniversaries and birth dates as far
  26.    back as Friday, April 13, 1888.)
  27.  
  28.    Calendar dates of the form mo-day-year (with year in full 4-digit form)
  29.    are carried in structures of type calday.  Simply declare that type for
  30.    your own variables, such as
  31.                                       var  mmddyy: calday;
  32.                                             start: integer;
  33.  
  34.    initializing the data as appropriate to your application.  E.g.,
  35.  
  36.              repeat
  37.                 CalDate(mmddyy, Today);
  38.                    (* establishing readln default values *)
  39.                 write(CON, 'Start Date (mo day year)? ');
  40.                 readln(CON, mmddyy.mo, mmddyy.da, mmddyy.year);
  41.                 if mmddyy.year < 77
  42.                 then mmddyy.year := mmddyy.year + 2000
  43.                 else if mmddyy.year < 100
  44.                      then mmddyy.year := mmddyy.year + 1900;
  45.                 until not BadDate(mmddyy);
  46.              start := since77(mmddyy);
  47.  
  48.    Ordinal dates are easier to store and manipulate within programs and data
  49.    wherever  direct use by people can be avoided.  Ordinal dates are perfect
  50.    for sorting by date, for comparison of two dates, and for determining the
  51.    exact number of days between any two dates.  (These are so useful that
  52.    larger systems, such as Common LISP, carry ordinal SECONDS from New Year's
  53.    Eve, GMT, January 1, 1900. }
  54.  
  55. type
  56.  
  57.    calday = record {Calendar date from 1978-01-01 to 2067-09-17.  This
  58.                     structure can be used for other dates on the Gregorian
  59.                     calendar as well, but only the above are guaranteed to
  60.                     have unambiguous, positive ordinal date values.  With
  61.             the procedures here, dates 1888-04-13 to 1977-12-31 are
  62.                     represented by ordinals < 1, but the nineteenth-century
  63.                     dates are generally not usable if you translate to a
  64.             different origin (such as 1980-01-01 for MSDOS or the
  65.             turn of the century value for ArpaNet and Common LISP}
  66.  
  67.               year: integer {typically 1900 .. 2067 with 0 for unknown
  68.                              in some applications };
  69.  
  70.                 mo: byte    {   1 .. 12 with 0 for unknown in some
  71.                              applications.  This sequence of fields
  72.                              should be maintained for use in sorting
  73.                              as typeless values when ordinal dates
  74.                              aren't convenient for that purpose};
  75.  
  76.                 da: byte    {   1 .. 31 with 0 for unknown in some
  77.                              applications.  Note that validity of
  78.                              the precise combination of values is
  79.                              very easily checked with the technique
  80.                              in the BadDate function. }
  81.  
  82.                 end {calday};
  83.  
  84.  
  85.  
  86.  
  87. function
  88.  
  89.    WeekDay(day: integer {since77 ordinal date})
  90.  
  91.        : integer {0 for Sunday, 1 for Monday, ..., 6 for Saturday};
  92.  
  93. begin {day-of-week for a specified since77 ordinal date}
  94.  
  95. while day < 1
  96.    do day := day+32767;
  97.       {Converting negative-range values properly}
  98.  
  99. WeekDay := pred(day) mod 7;
  100.  
  101. end {WeekDay};
  102.  
  103. function
  104.  
  105.    since77(date: calday {to be converted} )
  106.  
  107.        :integer {ordinal date: days that date is past 1977-12-31.
  108.                  This CP/M time-stamp basis has 1888-04-13 = day -32768,
  109.                                                 1977-12-31 = day  0
  110.                                                 2067-09-17 = day +32767  };
  111.    const
  112.  
  113.       CumDays: array [0 .. 24] of integer
  114.                {days prior to first day of month for normal and leap years}
  115.  
  116.                = (0, 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334,
  117.                      0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335  );
  118.  
  119.    var day: integer {intermediate accumulation};
  120.  
  121.    begin {since77}
  122.  
  123.    day :=   (date.year - 1978)*365 + ord(date.year < 1901);
  124.       {determining the number of non-leap days from the end of date.year-1
  125.        to the end of 1977, pre-compensating for 1900 being no leap year}
  126.  
  127.    if date.year < 1977 
  128.    then day := day + (date.year - 1980) div 4
  129.    else day := day + (date.year - 1977) div 4;
  130.       {figuring in number of leap days also passed over in that interval}
  131.  
  132.    if ((date.year and $3) = 0)  and (date.year <> 1900)
  133.    then date.mo := date.mo + 12;
  134.       {adjusting for the current year itself being a leap-year (including 2000
  135.         but not 1900) by using month numbers 13-24 instead of 1-12}
  136.  
  137.    since77 := day + CumDays[date.mo] + date.da;
  138.        {including the days prior to the requested day in the specified
  139.         year.  This procedure lets da = 0 usefully compute the last day
  140.         of the preceding month, a handy variation. }
  141.  
  142.  
  143.    end {since77};
  144.  
  145. procedure
  146.  
  147.    CalDate(var date: calday {returned as result};
  148.                 day: integer {since77 ordinal date});
  149.  
  150.    const
  151.  
  152.       CumDays: array [0 .. 24] of integer
  153.                {days prior to first day of month for normal and leap years}
  154.  
  155.                = (0, 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334,
  156.                      0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335  );
  157.                         {an intentional duplication to keep this data private}
  158.  
  159.    begin {CalDate conversion of a since77 ordinal date to its unique
  160.           corresponding Gregorian calendar date}
  161.  
  162.    date.mo := 12;  date.da := 31;
  163.       {setup to first compute the last day of year preceding that containing
  164.        the specified day number}
  165.  
  166.    if day < 0
  167.    then date.year := Trunc((day-730.75-ord(day<-28488))/365.25) + 1978
  168.         {adjusting early-year determination for the 1900 leap skip too}
  169.    else date.year := Trunc((day+730.0)/365.25) + 1975;
  170.         {determining the PREVIOUS calendar year with careful adjustment for
  171.          leap days going into those previous years};
  172.  
  173.    day := day - since77(date);
  174.       {accounting for days taken in preceding calendar years}
  175.  
  176.    date.year := succ(date.year);
  177.    if ((date.year and $3) = 0) and (date.year <> 1900)
  178.    then date.mo := 24;
  179.         {using the leap-year block if needed.  Otherwise,
  180.          start from date.mo = 12 already established}
  181.  
  182.    while day <= CumDays[date.mo]
  183.       do date.mo := pred(date.mo);
  184.          {finding the month containing day in the current year}
  185.  
  186.    date.da := day - CumDays[date.mo];
  187.       {figuring the number of days into the correct month}
  188.  
  189.    if date.mo > 12
  190.    then date.mo := date.mo - 12;
  191.       {dropping the special leap-year month numbering}
  192.  
  193.    end {CalDate};
  194.  
  195. function
  196.  
  197.    BadDate(date: calday {mo-da-year to be checked})
  198.  
  199.          :Boolean {for invalid calday, one not being for a unique
  200.                    ordinal date in the supported range};
  201.  
  202.    var check: calday {intermediate value for comparison};
  203.  
  204.    begin {Screening of the given date for proper value};
  205.  
  206.    CalDate(check, since77(date));
  207.       {finds the only supported date, if any, for the ordinal date produced by 
  208.        since77 for the given date.  The given date is valid here only if the
  209.        check value is identical. }
  210.    
  211.    BadDate :=     (check.year <> date.year) 
  212.                or (check.mo   <> date.mo  )
  213.                or (check.da   <> date.da  );
  214.  
  215.    end {BadDate};
  216.  
  217.  
  218.                           (* end of DAYLIB.PLB *)
  219.